home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Skunkware 5
/
Skunkware 5.iso
/
src
/
X11
/
tclMotif-1.4
/
programs
/
prog109
< prev
next >
Wrap
Text File
|
1995-06-29
|
3KB
|
119 lines
# Dan Hellers program 4.3, p 99
# show pixmaps, allow them to change cursor, file selection to
# change bitmaps. When doing this, use pixmaps in eg
# /usr/lib/X11/bitmaps
global pixmap
set pixmap xlogo32
xtAppInitialize
xmMainWindow .main managed -scrollBarDisplayPolicy as_needed \
-scrollingPolicy automatic
# mainWindow .main
xmLabel .main.label managed -labelType pixmap -labelPixmap $pixmap
# I am not supporting simple menu functions, so do this the long way
# top menu bar
xmMenuBar .main.menuBar managed
xmCascadeButton .main.menuBar.file managed \
-labelString File \
-mnemonic F
xmCascadeButton .main.menuBar.cursor managed \
-labelString Cursor \
-mnemonic E
xmCascadeButton .main.menuBar.help managed \
-labelString Help \
-mnemonic H
# file pulldown
xmPulldownMenu .main.menuBar.fileMenu
xmPushButton .main.menuBar.fileMenu.new managed \
-labelString "New..." \
-mnemonic N
xmPushButton .main.menuBar.fileMenu.quit managed \
-labelString Quit \
-mnemonic Q
.main.menuBar.file setValues -subMenuId .main.menuBar.fileMenu
# callbacks for file menu
.main.menuBar.fileMenu.quit activateCallback "exit 0"
.main.menuBar.fileMenu.new activateCallback fileDialog
# Cursor pulldown
xmPulldownMenu .main.menuBar.cursorMenu
xmToggleButton .main.menuBar.cursorMenu.X_cursor managed \
-labelString X_cursor
xmToggleButton .main.menuBar.cursorMenu.boat managed \
-labelString boat \
-mnemonic R
xmToggleButton .main.menuBar.cursorMenu.circle managed\
-labelString circle \
-mnemonic G
xmToggleButton .main.menuBar.cursorMenu.coffee_mug managed \
-labelString coffee_mug \
-mnemonic B
# .main.menuBar.cursorMenu.black setValues -set True
.main.menuBar.cursor setValues -subMenuId .main.menuBar.cursorMenu
# callbacks for edit menu
# note we use disarm rather than armed, because changed value
# not set till then
.main.menuBar.cursorMenu.X_cursor disarmCallback "change_cursor X_cursor"
.main.menuBar.cursorMenu.boat disarmCallback "change_cursor boat"
.main.menuBar.cursorMenu.circle disarmCallback "change_cursor circle"
.main.menuBar.cursorMenu.coffee_mug disarmCallback "change_cursor coffee_mug"
.main.menuBar.cursorMenu setValues -radioBehavior True \
-radioAlwaysOne True
# help pulldown
xmPulldownMenu .main.menuBar.helpMenu managed
xmPushButton .main.menuBar.helpMenu.help managed \
-labelString Help \
-mnemonic H
.main.menuBar.help setValues -subMenuId .main.menuBar.helpMenu
.main.menuBar setValues -menuHelpWidget .main.menuBar.help
.main setValues -workWindow .main.label \
-menuBar .main.menuBar
proc change_cursor {cursor} {
global isSet
global pixmap
.main.menuBar.cursorMenu.$cursor getValues -set isSet
if {$isSet == "true"} {
.main.label defineCursor $cursor
}
}
proc fileDialog {} {
# does this command already exist - else create it
if {[llength [info commands .fileDialog]] > 0} {
.fileDialog manageChild
} else {
xmFileSelectionDialog .fileDialog managed
.fileDialog okCallback load_pixmap
.fileDialog cancelCallback ".fileDialog unmanageChild"
}
}
proc load_pixmap {} {
global selection
global pixmap
.fileDialog getValues -dirSpec selection
.main.label setValues -labelPixmap $selection
set pixmap $selection
}
. realizeWidget
. mainLoop